Shareware Super Platinum 8/Shareware Super Platinum 8.iso/mac/PROGTOOL/VTP031.ZIP;1/VSTRINGU.PAS

Pascal/Delphi Source File | 1993-12-30 | 92.0 KB | 4,956 lines

{
ÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕ

Visionix String (VStringu) Unit
   Version 0.7
 Copyright 1991,92,93 Visionix
 ALL RIGHTS RESERVED

ƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒ

 Revision history in reverse chronological order:

 Initials  Date      Comment
 ƒƒƒƒƒƒƒƒ  ƒƒƒƒƒƒƒƒ  ƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒ

 jrt       11/28/93  Added CountWords, PosWord, GetWords.
                     Changed TakeWord to TakeWords.
                     Added PadLeft, PadRight, PadCenter.


 jrt       11/02/93  First logged revision.  Move stuff in from VGENu;
                     wrote string-list functions.

ÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕ
}

(*-

<Overview>

This unit implements a variety of functions for string allocation,
usage, and management.  It also includes a set of advanced functions
that implement a generic "string-list" mechanism which supports
string arrays, string pointer arrays, link-list string arrays, and
PChar arrays.


<Interface>

-*)

Unit VStringu;

Interface

{$IFNDEF OS2}
  {$DEFINE NOSTRINGS}
{$ENDIF}

{$IFNDEF VER60}
  {$DEFINE NOSTRINGS}
{$ENDIF}

Uses

{$IFNDEF NOSTRINGS}
  Strings,
{$ENDIF}
  VGenu,
  VTypesu;

{ƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒ}


Const

  {---------------------------------}
  { constants for string-list types }
  {---------------------------------}

  cslStrings   = $0001;
  cslPStrings  = $0002;
  cslLLStrings = $0003;
  cslPChars    = $0004;
  cslLLPChars  = $0005;


Type

  TPad  =  ( OnLeft, OnCenter, OnRight );

  {----------------------------------------}
  { Types for array of pointers to strings }
  {----------------------------------------}

  TPStrings = Array[1..1] of PSTRING;
  PPStrings = ^TPStrings;


  {---------------------------------------}
  { Types for array of pointers to PChars }
  {---------------------------------------}

  TPChars   = Array[1..1] of PCHAR;
  PPChars   = ^TPChars;


  TPointers = Array[1..1] of POINTER;
  PPointers = ^TPointers;

  {--------------------------------}
  { Types for link list of strings }
  {--------------------------------}

  PLLStringNode = ^TLLStringNode;

  TLLStringNode = RECORD

    S        : STRING;
    Next     : PLLStringNode;

  END;

  {-------------------------------}
  { types for link list of pchars }
  {-------------------------------}

  PLLPCharNode = ^TLLPCharNode;

  TLLPCharNode = RECORD

    S        : PChar;
    Next     : PLLPCharNode;

  END;

  {----------------------}
  { The String List type }
  {----------------------}

  TStrList = RECORD

    Flags   : WORD;
    Items   : WORD;
    ItemLen : WORD;
    SL      : POINTER;

  END;

  PStrList = ^TStrList;


{----------------------}
{ Character and String }
{----------------------}

Function  DeleteChars(            S              : STRING;
                                  Ch             : CHAR         ) : STRING;

Function  UpperChar(              C              : CHAR         ) : CHAR;

Function  UpperString(            S              : STRING       ) : STRING;

Function  ProperString(           S              : STRING       ) : STRING;

Function  RepeatString(           S              : STRING;
                                  Count          : BYTE         ) : STRING;


Function  Pad(                    S              : STRING;
                                  Len            : BYTE;
                                  TypeOPad       : TPad;
                                  Ch             : CHAR         ) : STRING;

Function  PadLeft(                S              : STRING;
                                  Len            : BYTE;
                                  Ch             : CHAR    ) : STRING;

Function  PadRight(               S              : STRING;
                                  Len            : BYTE;
                                  Ch             : CHAR    ) : STRING;

Function  PadCenter(              S              : STRING;
                                  Len            : BYTE;
                                  Ch             : CHAR    ) : STRING;

Function  Trim(                   S              : STRING;
                                  Len            : BYTE;
                                  TypeOTrim      : TPad         ) : STRING;

Function  TrimChar(               S              : STRING;
                                  TypeOTrim      : TPad;
                                  Ch             : CHAR         ) : STRING;

Function  LowerChar(              Ch             : CHAR         ) : CHAR;

Function  LowerString(            S              : STRING       ) : STRING;

Function  SR(                     Master,
                                  LookFor,
                                  ReplaceWith   : STRING        ) : STRING;

Function  GetNextParam(           SubS          : STRING;
                                  S             : STRING        ) : STRING;

Function  GetNextParamEx(         SubS          : STRING;
                                  S             : STRING;
                                  Delimiter     : CHAR          ) : STRING;

Function  TakeNextParamEx(    Var S             : STRING;
                                  Delimiter     : CHAR          ) : STRING;


Function  GetParamName(           SubS          : STRING        ) : STRING;

Function  GetParamData(           SubS          : STRING        ) : STRING;

Function  PosBefore(              SubS           : STRING;
                                  S              : STRING;
                                  Index          : BYTE         ) : BYTE;

Function  PosAfter(               SubS           : STRING;
                                  S              : STRING;
                                  Index          : BYTE         ) : BYTE;

Function  PosEnd(                 Subs           : STRING;
                                  S              : STRING       ) : BYTE;

Function  PosWord(                WordNum        : WORD;
                                  S              : STRING       ) : BYTE;

Function  CopyStr(                S1             : STRING;
                                  Index          : INTEGER;
                                  Count          : INTEGER      ) : STRING;


Function  TakeStr(            Var S1             : STRING;
                                  Index          : INTEGER;
                                  Count          : INTEGER   ) : STRING;


Function  CopyOverStr(            S1             : STRING;
                                  S2             : STRING;
                                  Index          : INTEGER;
                                  Count          : INTEGER      ) : STRING;

Function  OccurStr(               SubS           : STRING;
                                  S              : STRING       ) : BYTE;

Function  GetWords(               S         : STRING;
                                  NumWords  : WORD              ) : STRING;


Function  TakeWords(          Var S              : STRING;
                                  NumWords       : WORD         ) : STRING;

Function  CountWords(             S              : STRING       ) : BYTE;

Function  TakeQuote(          Var S              : STRING       ) : STRING;

Function  GetQuote(               S              : STRING       ) : STRING;




Function  AddCommas(              S              : STRING       ) : STRING;

Procedure CRC16String(            S              : STRING;
                              Var Result         : WORD;
                                  NewResult      : BOOLEAN      );

Procedure CRC32String(            S              : STRING;
                              Var Result         : LONGINT;
                                  NewResult      : BOOLEAN      );

Function  WordWrap(           Var Stt            : STRING;
                                  MaxWidth       : BYTE         ) : STRING;

Function  TruncAfter(             S              : STRING;
                                  After          : STRING       ) : STRING;

Function  TruncAfterEnd(          S              : STRING;
                                  After          : STRING       ) : STRING;


Function  TruncAt(                S              : STRING;
                                  At             : STRING       ) : STRING;

Function  TruncAtEnd(             S              : STRING;
                                  At             : STRING       ) : STRING;

Function  PosBuf(                 SubS           : STRING;
                              Var Buf;
                                  Count          : WORD         ) : LONGINT;

Function  PosBufNoCase(           SubS           : STRING;
                              Var Buf;
                                  Count          : WORD         ) : LONGINT;



{--------------------------}
{ String Array Conversions }
{--------------------------}

Procedure StrToArray(             S             : STRING;
                              Var TheArray                      );

Function  ArrayToStr(         Var TheArray;
                                  Len           : BYTE          ) : STRING;

Procedure StrToAsciiZ(            S             : STRING;
                              Var AsciiZStr                     );

Function  AsciiZtoStr(        Var AsciiZStr                     ) : STRING;



(* NOT IMPLEMENTED YET...

{---------------------------------------------}
{ Generic numeric string to value conversions }
{---------------------------------------------}

Function  StrToByteEx(            S            : STRING         ) : BYTE;

Function  StrToWordEx(            S            : STRING         ) : WORD;

Function  StrToIntEx(             S            : STRING         ) : INTEGER;

Function  StrToLongEx(            S            : STRING         ) : LONGINT;

*)


{-----------------------}
{ heap-string functions }
{-----------------------}

Function  VStrNew(                S             : STRING        ) : POINTER;

Function  VStrGet(                StringPtr     : PString       ) : STRING;


Procedure VStrDispose(            PrevNewString : PString       );

{-----------------------}
{ string list functions }
{-----------------------}

Function  VStrListNew(            Flags          : WORD;
                                  NumItems       : INTEGER;
                                  ItemLen        : WORD         ) : PStrList;

Procedure VStrListDispose(        SL             : PStrList     ) ;


Function  VStrListGetPtr(         StrList        : PStrList;
                                  StrNum         : INTEGER      ) : PSTRING;

Function  VStrListGetStr(         StrList        : PStrList;
                                  StrNum         : INTEGER      ) : STRING;

Procedure VStrListPutStr(         StrList        : PStrList;
                                  StrNum         : INTEGER;
                                  StrToPut       : STRING       );

Function  VStrListGetPChar(       StrList        : PStrList;
                                  StrNum         : INTEGER      ) : PChar;

Procedure VStrListPutPChar(       StrList        : PStrList;
                                  StrNum         : INTEGER;
                                  PCharToPut     : PChar        );

{----------------}
{ Misc functions }
{----------------}

Function ColorFromString(        S              : STRING       ) : BYTE;


Implementation


{ƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒ}


(*-

[FUNCTION]

Function  DeleteChars(            S              : STRING;
                                  Ch             : CHAR         ) : STRING;

[PARAMETERS]

S           Source String from which to Remove Characters
Ch          Character to Search for and Delete from String

[RETURNS]

String "S" with all instances of character "Ch" removed.

[DESCRIPTION]

Deletes all instances of the specified character from the
specified string.

[SEE-ALSO]

(none)

[EXAMPLE]

VAR
  S : STRING;

BEGIN

  S := 'V-I-S-I-O-N-I-X';
  S := DeleteChars( S, '-' );

  { S now equals 'VISIONIX' }

END;

-*)



Function  DeleteChars(            S              : STRING;
                                  Ch             : CHAR         ) : STRING;


Var

  Loopy : WORD;

BEGIN

  {-------------------------------------------------}
  { Delete all occurances of the variable 'Ch' that }

  { are continaed within the variable 'S'.          }
  {-------------------------------------------------}

  Loopy := 1;

  While ( Loopy <= Byte(S[0]) ) Do
  BEGIN

    If (S[Loopy] = Ch) Then
      Delete( S, Loopy, 1 )
    Else
      Inc( Loopy );

  END;

  DeleteChars := S;

END;   { Of DeleteChars }

{ƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒ}


(*-

[FUNCTION]

Function  UpperChar(              C              : CHAR         ) : CHAR;

[PARAMETERS]

C           The character to convert to Upper Case

[RETURNS]

The Character converted to Upper Case

[DESCRIPTION]

Converts a Character to Upper Case

[SEE-ALSO]

LowerChar
UpperString
LowerString
ProperString

[EXAMPLE]

VAR
  C : CHAR;

BEGIN

  C := UpperChar( 'a' );

  { C now equals 'A' }

END;

-*)

Function  UpperChar(              C              : CHAR         ) : CHAR;

BEGIN

  If ( C > #96 ) and ( C < #123 ) Then
    C := Char( Byte( C ) XOR 32 );

  UpperChar := C;

END;

{ƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒ}

(*-

[FUNCTION]

Function  UpperString(               S         : STRING  ) : STRING;

[PARAMETERS]

S           String to convert to Upper Case

[RETURNS]

String "S" in all Upper Case

[DESCRIPTION]

Converts an entire string to upper case.

[SEE-ALSO]

LowerString
ProperString
UpperChar
LowerChar

[EXAMPLE]

VAR
  S : STRING;

BEGIN

  S := 'This is a Test';
  S := UpperString( S );

  { S = 'THIS IS A TEST' }

END;

-*)


Function  UpperString(             S           : STRING  ) : STRING;

Var
  PosS : WORD;

BEGIN

  For PosS := 1 to Byte(S[0]) Do
    S[PosS] := UpperChar( S[PosS] );

  UpperString := S;

END;

{ƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒ}

(*-

[FUNCTION]

Function  ProperString(               S         : STRING  ) : STRING;

[PARAMETERS]

S           String to Modify

[RETURNS]

String "S" with the First Characters of each word in Upper Case.
All other characters in string "S" are made lower case.

[DESCRIPTION]

Converts the First Character of each Word in the String to
Upper Case.  Converts all other characters to lower case.

[SEE-ALSO]

UpperString
LowerString
UpperChar
LowerChar

[EXAMPLE]

VAR
  S : STRING;

BEGIN

  S := 'joHN pAUl JOnEs';
  S := ProperString( S );

  { S = 'John Paul Jones' }

END;

-*)

Function  ProperString(             S           : STRING  ) : STRING;

Var

  Upper  : BOOLEAN;
  L1     : BYTE;

BEGIN

  Upper  := True;

  For L1 := 1 to Byte(S[0]) do
  BEGIN

    If Upper Then
    BEGIN

      If (IsAlpha(S[L1])) Then
        Upper := False;

      S[L1] := UpCase(S[L1]);

    END
    Else
    BEGIN

      If NOT (IsAlphaNum(S[L1])) Then
        Upper := True
      Else
        S[L1] := LowerChar(S[L1]);

    END;

  END;

  ProperString := S;

END;


{ƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒ}

(*-

[FUNCTION]

Function  RepeatString(           S              : STRING;
                                  Count          : BYTE         ) : STRING;

[PARAMETERS]

s         string to repeat.
count     number of times to repeat the string.

[RETURNS]

The string "s" repeated "count" times.

[DESCRIPTION]

This function will return a string which contains the string "s"
repeated "count" times.

[SEE-ALSO]


[EXAMPLE]

  T := RepeatString( 'Hello', 3 );

  { T now equals 'HelloHelloHello' }

  T := RepeatString( '-', 20 );

  {               12345678901234567890  }

  { t now equals '--------------------' }


-*)


Function  RepeatString(           S              : STRING;
                                  Count          : BYTE         ) : STRING;

Var
  Z : INTEGER;
  RS: STRING;
BEGIN

  RS := '';

  For Z:=1 to Count Do
    RS := RS + S;

  RepeatString := RS;

END;


{ƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒ}

(*-

[FUNCTION]

Function  Pad(                       S         : STRING;
                                     Len       : BYTE;
                                     TypeOPad  : TPad;
                                     Ch        : CHAR    ) : STRING;

[PARAMETERS]

S           The string to pad
Len         The desired length of the resulting string
TypeOPad    Type of pad operation you wish to perform

                 Left   Adds the pad character to the left of string
                 Right  Adds the pad character to the right of string
                 Center Adds the pad character equally on either side of
                        string
Ch          Character to pad with

[RETURNS]

The newly padded string based on "S"

[DESCRIPTION]

Pads the string "S" with the character "Ch" so that the string is
"len" characters in length.  Three types of padding are supported:
LEFT pads the left of the string, RIGHT pads the right, and CENTER
pads on both sides.

  ++++++++++++++++++++++++++++++++++++++++++++++++++++
  +                                                  +
  + Note: Pad Left = Right Justified, and visa versa +
  +                                                  +
  ++++++++++++++++++++++++++++++++++++++++++++++++++++

[SEE-ALSO]

Trim

[EXAMPLE]

VAR
  S : STRING;

BEGIN

  {----------------}
  { CENTER padding }
  {----------------}

  S := 'Hello, World';
  S := Pad( S, 20, CENTER, '-' );

  { S now equals '----Hello, World----' }

  {--------------}
  { LEFT padding }
  {--------------}

  S := 'Hello, World';
  S := Pad( S, 20, LEFT, '-' );

  { T now equals '--------Hello, World' }

  {---------------}
  { RIGHT padding }
  {---------------}

  S := 'Hello, World';
  S := Pad( S, 20, RIGHT, '-' );

  { S now equals 'Hello, World--------' }

END;

-*)

Function  Pad(                     S           : STRING;
                                   Len         : BYTE;
                                   TypeOPad    : TPad;
                                   Ch          : CHAR    ) : STRING;

BEGIN

  Case TypeOPad of

    ONLEFT :

      While ( Byte(S[0]) < Len ) Do
        S := Ch + S;

    {---}

    ONCENTER :

      While ( Byte(S[0]) < Len ) Do
      BEGIN

        S := S + Ch;

        If ( Byte(S[0]) < Len ) Then
          S := Ch + S;

      END;

    {---}

    ONRIGHT :

      While ( Byte(S[0]) < Len) Do
        S := S + Ch;

  END;

  Pad := S;

END;

{ƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒ}


Function  PadLeft(                 S           : STRING;
                                   Len         : BYTE;
                                   Ch          : CHAR    ) : STRING;

BEGIN

  PadLeft   := Pad( S, Len, onLeft, CH );

END;



{ƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒ}


Function  PadRight(                S           : STRING;
                                   Len         : BYTE;
                                   Ch          : CHAR    ) : STRING;

BEGIN

  PadRight   := Pad( S, Len, onRight, CH );

END;


{ƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒ}


Function  PadCenter(               S           : STRING;
                                   Len         : BYTE;
                                   Ch          : CHAR    ) : STRING;

BEGIN

  PadCenter   := Pad( S, Len, onCenter, CH );

END;




{ƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒ}





(*-

[FUNCTION]

Function  Trim(                      S         : STRING;
                                     Len       : BYTE;
                                     TypeOTrim : TPad   ) : STRING;

[PARAMETERS]

S           The string to pad
Len         The desired length of the resulting string
TypeOTrim   Type of trim operation you wish to perform
                 Left   Removes characters from the left of the string
                 Right  Removes characters from the right of string
                 Center Removed characters equally on either side of
                        string

[RETURNS]

The newly trimmed string

[DESCRIPTION]

Trims the string "S".  If the "TypeOTrim" is LEFT, characters are
removed from the left side of the string until the length of the
string is "len".  If the "TypeOTrim" is RIGHT, characters are
removed from the right side of the string until the length of the
string is "len".  If the "TypeOTrim" is CENTER, characters are
removed from both sides of the string until the length is "len".

Trim and Pad are inverse functions - one repairs the other.

[SEE-ALSO]

Pad

[EXAMPLE]

VAR
  S : STRING;

BEGIN

  {-----------}
  { Trim LEFT }
  {-----------}

  S := Trim( '----Hello, World----', LEFT, 18 )

  { S now equals '--Hello, World----' }

  {------------}
  { Trim RIGHT }
  {------------}

  S := Trim( '----Hello, World----', RIGHT, 18 )

  { S now equals '----Hello, World--' }

  {-------------}
  { Trim CENTER }
  {-------------}

  S := Trim( '----Hello, World----', CENTER, 18 )

  { S now equals '---Hello, World---' }

END;

-*)



Function  Trim(                    S           : STRING;
                                   Len         : BYTE;
                                   TypeOTrim   : TPad    ) : STRING;

Var

  A : INTEGER;
  B : INTEGER;

BEGIN

  A := 1;
  B := Byte( S[0] );

  Case TypeOTrim of

    ONLEFT :

      BEGIN

        A := 1;
        B := Byte(S[0]);

        While (A <= B) AND (B-A > Len) Do
          Inc(A);

      END;

    {---}

    ONCENTER :

      BEGIN

        While (A <= B) AND (B-A > Len) Do
          Inc(A);

        B := Len;

{        While (B >= A) AND (S[B] = Ch) Do }
{          Dec(B);                         }

      END;

    {---}

    ONRIGHT :

      BEGIN
        B := Len;

{        While (B >= A) AND (B-S[B] = Ch) Do }
{          Dec(B);                           }

      END;

  END;

  S    := Copy( S, A, Succ(B-A) );
  Trim := S;

END;

{ƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒ}

(*-

[FUNCTION]

Function  TrimChar(                  S         : STRING;
                                     TypeOTrim : TPad;
                                     Ch        : CHAR    ) : STRING;

[PARAMETERS]

S           The string to pad
TypeOTrim   Type of trim operation you wish to perform
                 Left   Removes a character from the left of the string
                 Right  Removes a character from the right of string
                 Center Removed a character equally on either side of
                        string
Ch          Character to trim from side.  This prevents trimming of part
            of the data which happens to also be of the same pad char.

[RETURNS]

The newly trimmed string

[DESCRIPTION]

Trims the string "S".  If the "TypeOTrim" is LEFT, all leading
occurances of the character "CH" are removed from the string.
If the "TypeOTrim" is RIGHT, all trailing occurances of the character
"CH" are removed from the string.  If the "TypeOTrim" is CENTER, all
leading and trailing occurances of the character "CH" are removed
from the string.

[SEE-ALSO]

Pad
Trim

[EXAMPLE]

VAR
  S : STRING;

BEGIN

  {-----------}
  { Trim LEFT }
  {-----------}

  S := TrimChar( '----Hello, World!----', LEFT, '-' )

  { S now equals 'Hello, World!----' }

  {------------}
  { Trim RIGHT }
  {------------}

  S := TrimChar( '----Hello, World!----', RIGHT, '-' )

  { S now equals '----Hello, World!' }

  {-------------}
  { Trim CENTER }
  {-------------}

  S := TrimChar( '----Hello, World!----', CENTER, '-' )

  { S now equals 'Hello, World!' }

END;

-*)


Function  TrimChar(                S           : STRING;
                                   TypeOTrim   : TPad;
                                   Ch          : CHAR    ) : STRING;

Var

  A : INTEGER;
  B : INTEGER;

BEGIN

  A := 1;
  B := Byte( S[0] );

  Case TypeOTrim of

    ONLEFT :

      BEGIN

        A := 1;
        B := Byte(S[0]);

        While (A <= B) AND (S[A] = Ch) Do
          Inc(A);

      END;

    {---}

    ONCENTER :

      BEGIN

        While (A <= B) AND (S[A] = Ch) Do
          Inc(A);

        While (B >= A) AND (S[B] = Ch) Do
          Dec(B);

      END;

    {---}

    ONRIGHT :

      BEGIN

        While (B >= A) AND (S[B] = Ch) Do
          Dec(B);

      END;

  END;

  S        := Copy( S, A, Succ(B-A) );
  TrimChar := S;

END;

{ƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒ}

(*-

[FUNCTION]

Function  LowerChar(                 Ch        : CHAR    ) : CHAR;

[PARAMETERS]

Ch          The character to convert to lowercase

[RETURNS]

A lowercase character

[DESCRIPTION]

Converts a the specified character to Lower Case.

[SEE-ALSO]

UpperChar
UpperString
LowerString

[EXAMPLE]

VAR
  C : CHAR;

BEGIN

  C := LowerChar( 'A' );

  { C = 'a' }

END;

-*)

Function  LowerChar(               Ch          : CHAR    ) : CHAR;

BEGIN

  If ( (Ch >= #65) AND (Ch <= #90) ) Then
    Ch := Char( Byte(Ch) OR 32 );

  LowerChar := Ch;

END;

{ƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒ}

(*-

[FUNCTION]

Function  LowerString(               S         : STRING  ) : STRING;

[PARAMETERS]

S           String to convert the lowercase

[RETURNS]

A lowercase string.

[DESCRIPTION]

Converts the string "S" to lower case.

[SEE-ALSO]

LowerChar
UpperChar
UpperString

[EXAMPLE]

VAR
  S : STRING;

BEGIN

  S := LowerString( 'Now is the TIME for AlL...' );

  { S now equals 'now is the time for all...' }

END;

-*)


Function  LowerString(             S           : STRING  ) : STRING;

Var

  I : BYTE;

BEGIN

  For I := 1 to Byte(S[0]) Do

    If ( (S[I] >= #65) AND (S[I] <= #90) ) Then
      S[I] := Char( Byte(S[I]) OR 32 );

  LowerString := S;

END;

{ƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒ}

(*-

[FUNCTION]

Function  SR(                        Master,
                                     LookFor,
                                     ReplaceWith : STRING) : STRING;

[PARAMETERS]

Master      String to perform the search and replace on
LookFor     String to look for in "Master"
ReplaceWith String to replace "LookFor" with.

[RETURNS]

A new string, based on "Master", that has all occurances of the
string "LookFor" replaced with "ReplaceWith".

[DESCRIPTION]

Using a given String, Searches for the sub-string "Lookfor" and replaces
all instances with of it with another sub-string, "ReplaceWith"

+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+                                                                 +
+ Note: the SR function can be used to delete all occurances of a +
+ substring within a string by specifying nothing ('') as the     +
+ ReplaceWith parameter.                                          +
+                                                                 +
+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

[SEE-ALSO]

(none)

[EXAMPLE]

VAR
  S : STRING;

BEGIN

  S := SR( 'Now is the time.  Now I Say!', 'Now', 'Tomorrow' );

  { S now equals 'Tomorrow is the time.  Tomorrow I Say!' }

END;

-*)


Function  SR(                      Master,
                                   LookFor,
                                   ReplaceWith : STRING  ) : STRING;

Var

  Z : INTEGER;

BEGIN

  Z := Pos( LookFor, Master );

  While (Z > 0) Do
  BEGIN

    Delete( Master, Z, Byte(LookFor[0]) );
    Insert( ReplaceWith, Master, Z );
    Z := Pos( LookFor, Master );

  END;

  SR := Master;

END;

{ƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒ}

(*-

[FUNCTION]

Function  GetNextParam(              SubS      : STRING;
                                     S         : STRING  ) : STRING;

[PARAMETERS]

Subs        Sub-string that preceeds up to the parameter to get
S           Parameter list to get the next parameter from

[RETURNS]

The next Parameter following the given Starting Parameter Sub-String

[DESCRIPTION]

This function takes a string of text parameters (delimited by commas) and
searches for the parameter following the one provided.  The parameter may
be a single symbol or have a value following it (using an equals sign as
in the examples below).
The following Examples illustrate usage:
  Ex #1 : GetNextParam( 'B=C', 'A=B,B=C,C=D,D=10' ) = 'C=D'
  Ex #2 : GetNextParam( '',    'A=B,B=C,C=D,D=10' ) = 'A=B'
  Ex #3 : GetNextParam( 'B',   'A=B,B=C,C=D,D=10' ) = 'C=D'

[SEE-ALSO]

GetNextParamEx
GetParamName
GetParamData

[EXAMPLE]

VAR
  S,T : STRING;

BEGIN

  S := 'Ground=Brown,Sky=Blue,Trees=Green,World=Round';
  T := '';

  REPEAT

    S := GetNextParam( T, S );
    WriteLn( 'T="', T, '"' );

  UNTIL T = '';

  {----------------}
  { Output:        }
  {                }
  { "Ground=Brown" }
  { "Sky=Blue"     }
  { "Trees=Green"  }
  { "World=Round"  }
  {----------------}

  S := 'Ground=Brown,Sky=Blue,Trees=Green,World=Round';
  T := GetNextParam( 'Sky', S );

  { T = 'Trees=Green' }

END;

-*)


Function  GetNextParam(            SubS        : STRING;
                                   S           : STRING  ) : STRING;

Var

  Index : INTEGER;
  Count : BYTE;

BEGIN

  Count  := 0;

  If (Byte(SubS[0]) = 0) Then
    Index := 1
  Else
    Index := Pos( SubS, S );

  If ( Byte(SubS[0]) > 0 ) AND
     ( SubS[1] <> ',' ) AND
     ( Index > 0 ) Then
  BEGIN

    Repeat
      Inc( Index );
    Until ( Index >= Byte(S[0]) ) OR ( S[Index] = ',' );
    Inc( Index );

  END;

  While ( Index+Count < Byte(S[0]) ) AND ( S[Index+Count] <> ',' ) AND
        ( Index > 0 ) Do
    Inc( Count );

  If Index + Count = Byte(S[0]) Then
    Inc(Count);

  GetNextParam := Copy( S, Index, Count );

END;

{ƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒ}

(*-

[FUNCTION]

Function  GetNextParamEx(            SubS      : STRING;
                                     S         : STRING;
                                     Delimiter : CHAR    ) : STRING;

[PARAMETERS]

Subs        Sub-String that preceeds up to the parameter to get
S           Parameter list to get the next parameter from
Delimiter   Sub-String Separator Character

[RETURNS]

The next Parameter following the given Starting Parameter Sub-String.

[DESCRIPTION]

This function takes a string of text parameters (delimited by the
specified "Delimiter") and searches for the parameter following the one
provided.  The parameter may be a single symbol or have a value
following it (using an equals sign as in the examples below).

+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+                                                                 +
+ Note:  This function is an EXtended version of the GetNextParam +
+ function, with the extension of being able to specify the       +
+ character that seperates the parameters of a parameter string.  +
+                                                                 +
+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

[SEE-ALSO]

GetNextParam
GetParamName
GetParamData

[EXAMPLE]

VAR
  S : STRING;

BEGIN

  {------------}
  { Example #1 }
  {------------}

  S := GetNextParam( '',
                     'Ground=Brown,Sky=Blue|Trees=Green,World=Round',
                     '|' )

  { S now equals 'Ground=Brown,Sky=Blue' }

  {------------}
  { Example #2 }
  {------------}

  S := GetNextParam( 'Ground=Brown,Sky=Blue',
                     'Ground=Brown,Sky=Blue|Trees=Green,World=Round',
                     '|' )

  { S now equals 'Trees=Green,World=Round' }

END;

-*)


Function  GetNextParamEx(          SubS        : STRING;
                                   S           : STRING;
                                   Delimiter   : CHAR    ) : STRING;

Var

  Index : INTEGER;
  Count : BYTE;

BEGIN

  Count  := 0;

  If (Byte(SubS[0]) = 0) Then
    Index := 1
  Else
    Index := Pos( SubS, S );

  If ( Byte(SubS[0]) > 0 ) AND
     ( SubS[1] <> Delimiter ) AND
     ( Index > 0 ) Then
  BEGIN

    Repeat
      Inc( Index );
    Until ( Index >= Byte(S[0]) ) OR ( S[Index] = Delimiter );
    Inc( Index );

  END;

  While ( Index+Count < Byte(S[0]) ) AND
        ( S[Index+Count] <> Delimiter ) AND
        ( Index > 0 ) Do
    Inc( Count );

  If Index + Count = Byte(S[0]) Then
    Inc(Count);

  GetNextParamEx := Copy( S, Index, Count );

END;

{ƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒ}


Function  TakeNextParamEx(    Var S             : STRING;
                                  Delimiter     : CHAR          ) : STRING;


Var

  Z : INTEGER;

BEGIN


  If S='' THen
    TakeNextParamEx := ''
  Else
  BEGIN

    Z := Pos( Delimiter, S );

    IF Z=0 Then
      Z := Length( S )+1;

    TakeNextParamEx := TakeStr( S, 1, Z-1 );

    Delete( S, 1, 1 );

  END;

END;


{ƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒ}


(*-

[FUNCTION]

Function  GetParamName(              SubS      : STRING  ) : STRING;

[PARAMETERS]

SubS        Source Parameter String

[RETURNS]

Parameter Field Name from Source String

[DESCRIPTION]

This function returns the parameter name portion of a parameter string.
The parameter name portion is defined to be "the portion preceding the
equal sign."

[SEE-ALSO]

GetNextParamEx
PosNextData

[EXAMPLE]

VAR
  S : STRING;

BEGIN

  S := GetParamName( 'Trees=Green' );

  { S now equals 'Trees' }

END;

-*)


Function  GetParamName(            SubS        : STRING  ) : STRING;

Var

  PosField : INTEGER;

BEGIN

  PosField := Pos( '=', SubS );

  If PosField <> 0 Then
    GetParamName := Copy( SubS, 1, Pred(PosField) )
  Else
    GetParamName := SubS;

END;

{ƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒ}

(*-

[FUNCTION]

Function  GetParamData(               SubS      : STRING  ) : STRING;

[PARAMETERS]

SubS        Source Parameter String with Value

[RETURNS]

Parameter Field Value from Source String

[DESCRIPTION]

This function returns the data portion of a parameter string.  The
data portion is defined as "the portion following the equal sign".

[SEE-ALSO]

GetNextParamEx
GetParamName

[EXAMPLE]

VAR
  S : STRING;

BEGIN

  S := GetParamData( 'Trees=Green' );

  { T now equals 'Green' }

END;

-*)

Function  GetParamData(             SubS        : STRING  ) : STRING;

Var

  PosSub : INTEGER;

BEGIN

  PosSub := Pos( '=', SubS );

  If PosSub <> 0 Then
    GetParamData := TrimChar(
                      Copy( SubS, Succ(PosSub), Byte(SubS[0]) - PosSub ),
                      ONCENTER,
                      ' '       )
  Else
    GetParamData := '';

END;

{ƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒ}


(*-

[FUNCTION]

Function  PosBefore(                 SubS      : STRING;
                                     S         : STRING;
                                     Index     : BYTE    ) : BYTE;

[PARAMETERS]

SubS        Sub-String to locate
S           Source String to search
Index       Limiting Search Index

[RETURNS]

Index into Source String where Sub-String was Found

[DESCRIPTION]

This function is much like the standard POS function.  PosBefore
differs in that you can specify the "Index" at which to end the search.
If the specified "SubS"tring occurs before "Index", it's position will
be returned.  If it occurs after the "Index", or if it does not occur
in "S", the function will return a 0.

[SEE-ALSO]

PosNext
PosAfter
PosEnd

[EXAMPLE]

VAR
  S : STRING;

BEGIN

  {------------}
  { Example #1 }
  {------------}

  X := PosBefore( 'World',
                  'Hello, World!  Whats up?',
                  11  );

  (X now equals 0, since the string 'World' does not completely occur
   before the 11th character in the main string)

  {------------}
  { Example #2 }
  {------------}

  X := PosBefore( 'World',
                  'Hello, World!  Whats up?',
                  20  );


  {------------------------------------------------------------}
  { S now equals 8, since the string 'World' occurs before the }
  { 20th character in the main string, at the 8th character    }
  {------------------------------------------------------------}

END;

-*)

Function  PosBefore(                 SubS      : STRING;
                                     S         : STRING;
                                     Index     : BYTE    ) : BYTE;

Var

  P : BYTE;

BEGIN

  P := Pos(SubS, S);

  If P + Pred(Byte(SubS[0])) > Index Then
    P := 0;

  PosBefore := P;

END;

{ƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒ}


(*-

[FUNCTION]

Function  PosAfter(                  SubS      : STRING;
                                     S         : STRING;
                                     Index     : BYTE    ) : BYTE;

[PARAMETERS]

SubS        Sub-String to locate
S           Source String to search
Index       Starting Search Index

[RETURNS]

Index into Source String where Sub-String was Found

[DESCRIPTION]

This function is much like the standard POS function.  PosAfter
differs in that you can specify the "Index" at which to start the search.
If the specified "SubS"tring occurs after "Index", it's position will
be returned.  If it occurs before the "Index", or if it does not occur
in "S", the function will return a 0.

[SEE-ALSO]

Pos
PosNext
PosBefore
PosEnd

[EXAMPLE]

VAR
  B : BYTE;

BEGIN

  B := PosAfter( 'Hello', 'Excuse me, but: Hello, World!  Whats up?', 20 );

  {-----------------------------------------------------------}
  { B now equals 0, since the complete substring "Hello" does }
  { not occur after the 20th character of the main string     }
  {-----------------------------------------------------------}

END;

-*)

Function  PosAfter(                  SubS      : STRING;
                                     S         : STRING;
                                     Index     : BYTE    ) : BYTE;

Var

  P : BYTE;

BEGIN

  P := Pos(SubS, CopyStr(S, Index, Byte(S[0]) - Pred(Index)));

  If (P > 0) Then
    Inc(P, Pred(Index));

  PosAfter := P;

END;

{ƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒ}

(*-

[FUNCTION]

Function   PosEnd(                   Subs      : STRING;
                                     S         : STRING  ) : BYTE;

[PARAMETERS]

SubS        Sub-String
S           Source String to Search

[RETURNS]

Index into Source String where Sub-String was Found

[DESCRIPTION]

This function is much like the standard POS function.  PosEnd differs
in that the search is started from the end of the string instead of
the beggining.  This allows you to get the position of the LAST
occurance of a substring within a string.

This function will return the position of the last occurance of the
sub-string within the string.  If the sub-string is not found within
the string, this function will return 0.

[SEE-ALSO]

Pos
PosNext
PosBefore
PosAfter

[EXAMPLE]

VAR
  B : BYTE;

BEGIN
  B := PosEnd( 'Hello', 'Hello! Again I say Hello, World!  Whats up?' );

  { B = 20 }

END;

-*)

Function   PosEnd(                   Subs      : STRING;
                                     S         : STRING  ) : BYTE;

Var

  Z     : BYTE;
  Found : BOOLEAN;

BEGIN

  Z := Length( S );

  Found := FALSE;

  While (Z>0) and (Not Found) Do
  BEGIN

    If S[Z] = SubS[1] Then
    BEGIN

      If Copy( S, Z, Length(Subs) ) = Subs Then
        Found := TRUE
      Else
        Dec( Z );

    END
    ELSE
      Dec( Z );

  END;

  PosEnd := Z;

END;

{ƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒ}

(*-

[FUNCTION]

Function  PosWord(                WordNum        : WORD;
                                  S              : STRING       ) : BYTE;

[PARAMETERS]

WordNum     Word to get the starting position of
S           Source String to Search

[RETURNS]

Index into Source String where word # "wordnum" starts

[DESCRIPTION]

This function returns the position within the string "s" at which
the specified word # "wordnum" starts.  If "wordum" number of words
can not be found in the string, this function will return 0.

[SEE-ALSO]

Pos
PosNext
PosBefore
PosAfter

[EXAMPLE]

VAR
  B : BYTE;

BEGIN
                   {123456789012345678012345678901234567}

  B := PosWord( 3, 'Now is the time for all good people.');

  { B = 8 }

END;

-*)


Function  PosWord(                WordNum        : WORD;
                                  S              : STRING       ) : BYTE;

Var

  EndOfs  : BYTE;
  LastOfs : BYTE;
  CurOfs  : BYTE;

BEGIN

  { get rid of leading/trailing spaces and add a terminating space }

  S := TrimChar( S, OnCenter, ' ' )+' ';

  { loop through the string }

  EndOfs  := 0;
  LastOfs := 1;
  CurOfs  := 1;

  While ( EndOfs <= Length( S ) ) and
        ( WordNum >0           ) Do
  BEGIN

    Inc( EndOfs );

    If (S[EndOfs]=' ') Then
    BEGIN
      Dec( WordNum );
      CurOfs := LastOfs;
      LastOfs := Succ( EndOfs );
    END;

  END;

  { if we didnt find all the words, return a 0 }

  If WordNum<>0 Then
    PosWord := 0
  Else
    PosWord := CurOfs;

END;


{ƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒ}



(*-

[FUNCTION]

Function  CopyStr(                   S1        : STRING;
                                     Index     : INTEGER;
                                     Count     : INTEGER ) : STRING;

[PARAMETERS]

S1          Source String to Copy from
Index       Position in Source String to Start Copy at
Count       Number of Characters to Copy

[RETURNS]

The specified sub-string, starting at "index" and going for "count"
bytes.

[DESCRIPTION]

This function is the same as the standard Turbo Pascal "Copy" Command.

[SEE-ALSO]

CopyOverStr

[EXAMPLE]

VAR
  S : STRING;

BEGIN

  S := CopyStr( 'The Color is Blue.', 14, 4 );

  { S now equals "Blue" }

END;

-*)



Function  CopyStr(                   S1        : STRING;
                                     Index     : INTEGER;
                                     Count     : INTEGER ) : STRING;

Var

  S2 : STRING;

BEGIN

  If ( Count + Index ) > Byte( S1[0] ) Then
  BEGIN

    Count := Byte(S1[0]) - Index;
    Inc( Count );

  END;

  Move( S1[Index], S2[1], Count );
  S2[0] := Char( Count );
  CopyStr := S2;

END;


(*-

[FUNCTION]

Function  TakeStr(                   S1        : STRING;
                                     Index     : INTEGER;
                                     Count     : INTEGER ) : STRING;

[PARAMETERS]

S1          Source String to take from
Index       Position in Source String to Start take at
Count       Number of Characters to take

[RETURNS]

The specified sub-string, starting at "index" and going for "count"
bytes.

[DESCRIPTION]

This function is the similar to the standard Turbo Pascal "Copy"
Command.  It differs in that it returns the sub-string also removes
the sub-string from the original string.

[SEE-ALSO]

CopyOverStr

[EXAMPLE]

VAR
  S : STRING;

BEGIN

  T := 'The Color is Blue.';

  S := TakeStr( T, 14, 4 );

  { S now equals "Blue" }

  { t now equals "The Color is." }

END;

-*)





Function TakeStr(                Var S1        : STRING;
                                     Index     : INTEGER;
                                     Count     : INTEGER   ) : STRING;

BEGIN

  TakeStr := CopyStr( S1, Index, Count );

  Delete( S1, Index, Count );

END;


{ƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒ}

(*-

[FUNCTION]

Function  CopyOverStr(               S1        : STRING;
                                     S2        : STRING;
                                     Index     : INTEGER;
                                     Count     : INTEGER  ) : STRING;

[PARAMETERS]

S1          string that will be overwritten into S2
S2          original string
Index       Position in the original string (s2) to overwrite at
Count       Number of Characters to overwrite

[RETURNS]

String "s2" with string "s1" overwritten at "index" for "count"
characters.

[DESCRIPTION]

This function takes the string "S1" and uses it to overwrite
a portion of "S2", starting at the specified "index" and for
the specified "count" of number of characters.

[SEE-ALSO]

CopyStr

[EXAMPLE]

VAR
  S : STRING;

BEGIN

  S := 'The Color is Cyan on gold.';
  S := CopyOverStr( S, 'Blue', 14, 4 );

  { S now equals "The Color is Blue on gold." }

END;

-*)

Function  CopyOverStr(               S1        : STRING;
                                     S2        : STRING;
                                     Index     : INTEGER;
                                     Count     : INTEGER  ) : STRING;

Var

  NewLen : WORD;
  S3     : STRING;

BEGIN

  NewLen := Index + Count;

  If NewLen > 255 Then
    NewLen := 255;

  If NewLen < Byte(S2[0]) Then
    NewLen := Byte(S2[0]);

  FillChar( S3[1], NewLen, ' ' );
  S3[0] := Char(NewLen);
  Move( S2[1], S3[1],     Byte(S2[0]) );
  Move( S1[1], S3[Index], Count );

  CopyOverStr := S3;

END;

{ƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒ}

(*-

[FUNCTION]

Function  OccurStr(                  SubS      : STRING;
                                     S         : STRING   ) : BYTE;

[PARAMETERS]

SubS        Sub-String to look for
S           Source String to Search in

[RETURNS]

The number of times the sub-string "subs" was found in the
source string "s".

[DESCRIPTION]

This function searches the source string "s" for any and all occurances
of the sub-string "subs".  It returns a counts of the number of times
"subs" occured in "S".

[SEE-ALSO]

Pos

[EXAMPLE]

VAR
  S     : STRING;
  Count : BYTE;

BEGIN

  S     := 'This is the way it is here.';
  Count := OccurStr( 'is', S );

  { Count = 2 }

END;

-*)


Function  OccurStr(                  SubS      : STRING;
                                     S         : STRING   ) : BYTE;

Var

  Result : BYTE;
  Pos1   : BYTE;

BEGIN

  Result := 0;

  {-----------------------------------------}
  { To simulate the TP60 "bug".  Otherwise, }
  { assume compiling under TP70.            }
  {-----------------------------------------}

  If SubS = '' Then
  {$IFDEF VER60}
    OccurStr := 1
  {$ELSE}
    OccurStr := 0
  {$ENDIF}
  Else
  BEGIN

    Pos1 := 1;

    While (S <> '') AND (Pos1 <> 0) Do
    BEGIN

      Pos1 := Pos( SubS, S );

      If Pos1 <> 0 Then
      BEGIN

        Inc(Result);
        Delete( S, 1, LesserInt( Pos1 + Pred(Byte(SubS[0])), Byte(S[0]) ) );

      END;

    END;

    OccurStr := Result;

  END;

END;

{ƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒ}

(*-

[FUNCTION]

Function  GetWords(                 S         : STRING;
                                    NumWords  : WORD     ) : STRING;

[PARAMETERS]

S           Source string to get word from

[RETURNS]

The first "numwords" found in the string "s".

[DESCRIPTION]

This function searches the source string "s" for the first "numwords"
words and returns those words.

[SEE-ALSO]

TakeQuote

[EXAMPLE]

VAR
  S,Tmp : STRING;

BEGIN

  S := 'This is a string with 9 words in it';

  Tmp := GetWords( S, 2 );

  { tmp now equals 'This is' }

END;

-*)


Function GetWords(                   S         : STRING;
                                     NumWords  : WORD      ) : STRING;

Var

  EndOfs : BYTE;

BEGIN

  { get rid of leading spaces }

  S := TrimChar( S, OnLeft, ' ' );

  { loop through the string }

  EndOfs := 0;

  While ( EndOfs <= Length( S ) ) and
        ( NumWords >0           ) Do
  BEGIN
    Inc( EndOfs );
    If S[EndOfs] = ' ' Then
      Dec( NumWords );
  END;

  IF S[EndOfs]=' ' Then
    Dec( EndOfs );

  GetWords := Copy( S, 1, EndOfs );


END;

{ƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒ}


(*-

[FUNCTION]

Function  TakeWords(             Var S         : STRING   ) : STRING;

[PARAMETERS]

S           Source string to take words from

[RETURNS]

The first "numwords" found in the string "s".
(VAR S modified ["numwords" are removed])

[DESCRIPTION]

This function searches the source string "s" for the first "numwords"
words and returns those words.  It also takes the words out of the
string "s"

[SEE-ALSO]

GetWords
TakeQuote

[EXAMPLE]

VAR
  S,Tmp : STRING;

BEGIN

  S := 'This is a string with 9 words in it';

  REPEAT

    Tmp := TakeWords( S,1 );
    WriteLn( Tmp );  { Writes one word at a time }

  UNTIL S = '';

  {
  Output:

    This
    is
    a
    string
    with
    9
    words
    in
    it
  }

END;

-*)


Function TakeWords(              Var S         : STRING;
                                     NumWords  : WORD      ) : STRING;

Var

  EndOfs : BYTE;

BEGIN

  { get rid of leading spaces }

  S := TrimChar( S, OnLeft, ' ' );

  { loop through the string }

  EndOfs := 0;

  While ( EndOfs <= Length( S ) ) and
        ( NumWords >0           ) Do
  BEGIN
    Inc( EndOfs );
    If S[EndOfs] = ' ' Then
      Dec( NumWords );
  END;

  IF S[EndOfs]=' ' Then
    Dec( EndOfs );

  TakeWords := Copy( S, 1, EndOfs );

  { take em out }

  Delete( S, 1, EndOfs );

END;

(*
Function TakeWord(               Var S         : STRING   ) : STRING;

Var

  C1 : BYTE;
  C2 : BYTE;
  S2 : STRING;

BEGIN

  C1 := 1;
  While ((S[C1] = ' ') AND
         (C1 <= Byte(S[0]))) Do
    Inc(C1);

  If (C1 > 80) Then
  BEGIN

    TakeWord := '';
    Exit;

  END;

  C2 := C1;
  While ((S[C2] <> ' ') AND
         (S[C2] <> '"') AND
         (C2 <= Byte(S[0]))) Do
    Inc(C2);

  If (S[C2] = '"') AND (C2 = C1) Then
    Inc(C2);

  Delete( S, 1, Pred(C1) );
  S2 := CopyStr( S, 1, C2 - C1 );
  Delete( S, 1, C2 - C1 );
  TakeWord := S2;

END;
*)


{ƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒ}


(*-

[FUNCTION]

Function  CountWords(             S              : STRING       ) : BYTE;

[PARAMETERS]

S           Source string to count the words in

[RETURNS]

The number of words in the string "S"

[DESCRIPTION]

This function returns a count of the number of words in the
string "S".

[SEE-ALSO]

GetWords
TakeWords
PosWord

[EXAMPLE]

BEGIN
       {1    2  3 4      5    6 7     8  9  }

  S := 'This is a string with 9 words in it';

  B := CountWords( S );

  { b now equals 9 }


END;

-*)


Function  CountWords(             S              : STRING       ) : BYTE;

Var

  Ofs      : BYTE;
  NumWords : BYTE;

BEGIN

  { get rid of leading/trailing spaces and add space terminator }

  S := TrimChar( S, OnCENTER, ' ' )+' ';

  If Length(S)=1 Then
  BEGIN
    CountWords := 0;
    Exit;
  END;

  NumWords := 0;

  { loop through the string }

  For Ofs := 1 to Length( S ) Do
  BEGIN

    If (S[Ofs]       =  ' '          ) and

       ( ( Succ(ofs)=Length(S) ) or
         ( S[Succ(ofs)] <> ' ' )     ) Then

      Inc( NumWords );

  END;

  CountWords := NumWords;


END;

{ƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒ}

(*-

[FUNCTION]

Function  TakeQuote(             Var S         : STRING   ) : STRING;

[PARAMETERS]

S           VAR Source string to parse (MODIFIED ON RETURN)

[RETURNS]

The first quoted text-string found in the source string "S".

[DESCRIPTION]

This function searches for and returns the first quoted string in
the source string "S".  Additionally, if a quoted string is found,
it is removed form the string "S".  The returned/taken string
does not include the quote (") characters.

[SEE-ALSO]

TakeWord

[EXAMPLE]

VAR
  S,T : STRING;

BEGIN

  S := 'The Password is "Zulu"';
  T := TakeQuote( S );

  {------------------------}
  { T = 'Zulu'             }
  { S = 'The Password is ' }
  {------------------------}

END;

-*)


Function TakeQuote(              Var S         : STRING   ) : STRING;

Var

  Cmd    : STRING;
  MsgCmd : STRING;
  Idx1   : BYTE;
  Idx2   : BYTE;
  Count  : BYTE;

BEGIN

  Idx1 := Pos( '"', S );
  Delete( S, Idx1, 1 );
  Idx2 := Pos( '"', S );
  Count := Idx2 - Idx1;

  TakeQuote := Copy( S, Idx1, Count );
  Delete( S, Pred(Idx1), Count+2 );

END;

{ƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒ}

(*-

[FUNCTION]

Function GetQuote(                 S         : STRING   ) : STRING;

[PARAMETERS]

S           the string to look for a quote in.

[RETURNS]

The first quoted text-string found in the source string "S".

[DESCRIPTION]

This function searches for and returns the first quoted string in
the source string "S".  The returned string does not include the
quote (") characters.

[SEE-ALSO]

TakeWord
TakeQuote

[EXAMPLE]

VAR
  S,T : STRING;

BEGIN

  S := 'The Password is "Zulu"';
  T := TakeQuote( S );

  {------------------------------}
  { T = 'Zulu'                   }
  { S = 'The Password is "Zulu"' }
  {------------------------------}

END;

-*)


Function GetQuote(                  S         : STRING   ) : STRING;

Var

  P1, P2 : INTEGER;

BEGIN

  P1 := Pos( '"', S );

  If P1>0 Then
  BEGIN

    P2 := PosAfter( '"', S, P1+1 )-1;

    If P2>0 Then
      GetQuote := Copy( S, P1+1, P2-P1 )
    Else
      GetQuote := '';

  END
  ELSE
    GetQuote := '';


END;


{ƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒ}




(*-

[FUNCTION]

Function  AddCommas(                 S         : STRING   ) : STRING;

[PARAMETERS]

S           Text-String representation of a Number

[RETURNS]

string representation of the number with proper commas inserted.

[DESCRIPTION]

This function takes a Number in Text format (IE: "10", not "ten") and
inserts the commas at the hundered, thousands, ten-thousands place,
etc. until the number has been full "commatized".

[SEE-ALSO]

(None)

[EXAMPLE]

VAR
  S : STRING;

BEGIN

  S := '123456789';
  S := AddCommas( S );

  { S = '123,456,789' }

END;

-*)


Function AddCommas(                  S         : STRING   ) : STRING;

Var

  Index     : WORD;
  NextIndex : WORD;
  Count     : WORD;
  L1        : BYTE;
  L2        : BYTE;

BEGIN

  NextIndex := 1;
  Index := NextIndex;

  REPEAT

    While ( Index <= Byte(S[0]) ) AND
          ( NOT IsNum(S[Index]) ) Do
      Inc( Index );

    If Index <= Byte(S[0]) Then
    BEGIN

      Count := Index;
      While ( Count < Byte(S[0]) ) AND
            ( IsNum(S[Succ(Count)]) ) Do
        Inc( Count );

      NextIndex := Succ(Count);

      If (S[NextIndex] = '.') Then
      BEGIN

        Inc(NextIndex);

        While ( NextIndex <= Byte(S[0]) ) AND
              ( IsNum(S[NextIndex]) )  Do
          Inc( NextIndex );

      END;

      L2 := 0;
      For L1 := LesserInt(Count, Byte(S[0])) DownTo Index Do
      BEGIN

        Inc(L2);

        If (L2 = 3) AND
           (L1 <> Index) Then
        BEGIN

          Insert(',', S, L1);
          Inc(NextIndex);
          L2 := 0;

        END;

      END;

      Index := NextIndex;

    END;

  UNTIL (Index > Byte(S[0]));

  AddCommas := S;

END;

{ƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒ}


(*-

[FUNCTION]

Procedure CRC16String(               S         : STRING;
                                 Var Result    : WORD;
                                     NewResult : BOOLEAN  );

[PARAMETERS]

S           String to CRC
Result      VAR Returned 16-bit CRC of String plus prior CRC
NewResult   flag to indicate if this is an intial CRC operation

[RETURNS]

(VAR     : [Result] 16-bit CRC of string plus initial CRC value)

[DESCRIPTION]

Computes a 16-Bit CRC on the specified string "S".

If the NewResult flag is TRUE then "result" is based soley upon the
provided string.  If the "NewResult" Flag is FALSE then the result is
computed as a continuation of a CRC which has been previously
calculated and is passed in the variable "result"

[SEE-ALSO]

CRC16Char
CRC16Buffer
CRC32Char
CRC32String
CRC32Buffer

[EXAMPLE]

VAR
  S      : STRING;
  CRC32  : LONGINT;
  NewCRC : BOOLEAN;
BEGIN

VAR
  S     : STRING;
  CRC16 : WORD;

BEGIN

  S := 'She sells sea shells down by the sea shore';
  CRC16String( S, CRC32, TRUE );

  { CRC16 = $4941 }

END;

-*)

Procedure CRC16String(               S         : STRING;
                                 Var Result    : WORD;
                                     NewResult : BOOLEAN  );

Var

  P : POINTER;
  I : WORD;

BEGIN

  If NewResult Then
    Result := $FFFF;

  For I := 1 to Byte(S[0]) Do
    CRC16Char( S[I], Result );

END;

{ƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒ}

(*-
[FUNCTION]

Procedure CRC32String(               S         : STRING;
                                 Var Result    : LONGINT;
                                     NewResult : BOOLEAN  );


[PARAMETERS]

S           String to CRC
Result      VAR Returned 32-bit CRC of String plus prior CRC
NewResult   flag to indicate if this is an intial CRC operation

[RETURNS]

(VAR     : [Result] 32-bit CRC of string plus initial CRC value)

[DESCRIPTION]

Computes a 32-Bit CRC on the specified string "S".

If the NewResult flag is TRUE then "result" is based soley upon the
provided string.  If the "NewResult" Flag is FALSE then the result is
computed as a continuation of a CRC which has been previously
calculated and is passed in the variable "result"

[SEE-ALSO]

CRC16Char
CRC16String
CRC16Buffer
CRC32Char
CRC32Buffer

[EXAMPLE]

VAR
  S     : STRING;
  CRC32 : LONGINT;

BEGIN

  S := 'She sells sea shells down by the sea shore';
  CRC32String( S, CRC32, TRUE );

  { CRC32 = $7C6912A6 }

END;

-*)

Procedure CRC32String(               S         : STRING;
                                 Var Result    : LONGINT;
                                     NewResult : BOOLEAN  );

Var

  P : POINTER;
  I : WORD;

BEGIN

  If NewResult Then
    Result := $FFFFFFFF;

  For I := 1 to Byte(S[0]) Do
    CRC32Char( S[I], Result );

END;

{ƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒ}

(*-

[FUNCTION]

Function  WordWrap(           Var Stt            : STRING;
                                  MaxWidth       : BYTE         ) : STRING;

[PARAMETERS]

Stt         Source string.
MaxWidth    Right most edge at which to cut off source string.

[RETURNS]

Stt         Unused portion of result.
String truncated to last Grammar or Space character.


[DESCRIPTION]

Truncates the source string to fit smoothly within a certain "maxwidth".
Returns the string truncated to the last grammar or space character.

The left-over portion of the string is returned in "Stt".  If no grammer
delimiter is found, then the original source string is returned.

[SEE-ALSO]

TakeQuote

[EXAMPLE]


  {              2         3         4         5
        123456789012345678901234567890123456789012345678901   }

  S := 'Now this is the time for all gentlemen to word wrap.';

  T := WordWrap( S, 45 );

  { s now equals "Now this is the time for all" }
  { t now equals "gentlemen to word wrap."      }


-*)

Function  WordWrap(           Var Stt            : STRING;
                                  MaxWidth       : BYTE         ) : STRING;

Var

  Temp  : STRING;
  Count : WORD;
  Size  : BYTE;

BEGIN

  Temp := Stt;
  Stt  := '';

  If Length(Temp) < MaxWidth Then
     MaxWidth := Length(Temp);

  If Length(temp) > MaxWidth Then
  For Count := MaxWidth Downto 1 Do
  Begin

    If (Temp[Count] = #32) or IsGrammar(Temp[Count]) Then
    BEGIN

      Stt := Copy ( Temp, 1,Count );

      Delete(Temp,1,count);
{      Move( Temp[Succ(Count)], Stt[1], Size);}
{      Stt[0] := Char(Size);}

{      Temp[0] := Char(Count);}

      Count := 1;

    END;
  End
  Else
  Begin
     Stt  := Temp;
     Temp := '';
  End;


   WordWrap := stt;
   Stt      := Temp;

END;

{ƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒ}

Function  TruncAfter(             S              : STRING;
                                  After          : STRING       ) : STRING;

Var

  P : INTEGER;

BEGIN


  P := Pos( After, S );

  If P>0 Then
  BEGIN

    TruncAfter := Copy( S, 1, P+Length(After )-1 );

  END
  ELSE
    TruncAfter := S;

END;

{ƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒ}

Function  TruncAfterEnd(          S              : STRING;
                                  After          : STRING       ) : STRING;

Var

  P : INTEGER;

BEGIN


  P := PosEnd( After, S );

  If P>0 Then
  BEGIN

    TruncAfterEnd := Copy( S, 1, P+Length(After )-1 );

  END
  ELSE
    TruncAfterEnd := S;

END;

{ƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒ}

Function  TruncAt(                S              : STRING;
                                  At             : STRING       ) : STRING;

Var

  P : INTEGER;

BEGIN


  P := Pos( At, S );

  If P>0 Then
  BEGIN

    TruncAt := Copy( S, 1, P-1 );

  END
  ELSE
    TruncAt := S;

END;

{ƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒ}

Function  TruncAtEnd(             S              : STRING;
                                  At             : STRING       ) : STRING;

Var

  P : INTEGER;

BEGIN


  P := PosEnd( At, S );

  If P>0 Then
  BEGIN

    TruncAtEnd := Copy( S, 1, P-1 );

  END
  ELSE
    TruncAtEnd := S;

END;

{ƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒ}

(*-

[FUNCTION]

Function  PosBuf(                 SubS           : STRING;
                              Var Buf;
                                  Count          : WORD         ) : LONGINT;

[PARAMETERS]

Buf         Buffer to look at.
Count       Number of bytes to look through.
SubS        Substring to look for.

[RETURNS]

Location of SubS within the given buffer.

[DESCRIPTION]

Finds location of a substring within a buffer.  Will return -1 if not
found.

[SEE-ALSO]

StrInBufNoCase

[EXAMPLE]

Const BufMax : WORD = 1000;
Type TBuf = Array[0..0] of Char;
Var
  Buf     : ^TBuf;
  SubS    : STRING;
  PlaceAt : LONGINT;

  FS      : TFontSet;

BEGIN
  Getmem( Buf, BufMax );
  FillChar( Buf^, BufMax, 0 );
  SubS := 'Look for me';
  PlaceAt := 42;
  Move(SubS[1], Buf^[PlaceAt], Byte(SubS[0]));
  LookS := 'Look For Me';
  WriteLn( 'Found at ', PosBufNoCase(SubS, Buf^, BufMax) ); { Found at 42 }
  Freemem( Buf, BufMax );
END.

-*)

Function  PosBuf(                 SubS           : STRING;
                              Var Buf;
                                  Count          : WORD         ) : LONGINT;

Var

  PosB   : LONGINT;
  PosS   : BYTE;
  P      : POINTER;

BEGIN

  PosB := 0;
  PosS := 1;

  While ( PosB <= Count ) AND
        ( PosS <= Byte(SubS[0]) ) Do
  BEGIN

    If (TCharArray(Buf)[PosB] = SubS[PosS]) Then
      Inc(PosS)
    Else
      PosS := 1;

    Inc(PosB);

  END;

  If PosS > Byte(SubS[0]) Then
    PosBuf := Pred(PosB) - Byte(SubS[0])
  Else
    PosBuf := -1;

END;

{ƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒ}

(*-

[FUNCTION]

Function  PosBufNoCase(           SubS           : STRING;
                              Var Buf;
                                  Count          : WORD         ) : LONGINT;

[PARAMETERS]

Buf         Buffer to look at.
Count       Number of bytes to look through.
SubS        Substring to look for.

[RETURNS]

Location of SubS within the given buffer.

[DESCRIPTION]

Works same as StrInBuf, except this ignores case.

[SEE-ALSO]

StrInBuf

[EXAMPLE]

Const BufMax : WORD = 1000;
Type TBuf = Array[0..0] of Char;
Var
  Buf     : ^TBuf;
  SubS    : STRING;
  LookS   : STRING;
  PlaceAt : LONGINT;

  FS      : TFontSet;

BEGIN
  Getmem( Buf, BufMax );
  FillChar( Buf^, BufMax, 0 );
  SubS := 'Look for me';
  PlaceAt := 990;
  Move(SubS[1], Buf^[PlaceAt], Byte(SubS[0]));
  LookS := 'Look For Me';
  WriteLn( 'Found at ', PosBufNoCase(LookS, Buf^, BufMax) ); { Found at 990 }
  Freemem( Buf, BufMax );
END.

-*)

Function  PosBufNoCase(           SubS           : STRING;
                              Var Buf;
                                  Count          : WORD         ) : LONGINT;

Var

  PosB   : LONGINT;
  PosS   : BYTE;
  P      : POINTER;

BEGIN

  PosB := 0;
  PosS := 1;

  While ( PosB <= Count ) AND
        ( PosS <= Byte(SubS[0]) ) Do
  BEGIN

    If ( UpCase(TCharArray(Buf)[PosB]) = UpCase(SubS[PosS]) ) Then
      Inc(PosS)
    Else
      PosS := 1;

    Inc(PosB);

  END;

  If PosS > Byte(SubS[0]) Then
    PosBufNoCase := Pred(PosB) - Byte(SubS[0])
  Else
    PosBufNoCase := -1;

END;

{ƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒ}

(*-

[FUNCTION]

Procedure StrToArray(                S         : STRING;
                                 Var TheArray            );

[PARAMETERS]

S           Pascal String to convert to an array
TheArray    VAR working array to return results in

[RETURNS]

Function : None
(Var     : [TheArray] The array of characters so stored)

[DESCRIPTION]

This function converts a PASCAL String into an Array of Characters.
(NOTE: The Array is NOT Zero Terminated or length denoted by any means!)

[SEE-ALSO]

ArrayToStr

[EXAMPLE]

TYPE
  TArr = ARRAY[1..10] of CHAR;

VAR
  S   : STRING;
  Arr : TArr;

BEGIN

  S := 'Hello';
  StrToArray( S, Arr );

  { Arr[1]='H', .. ,Arr[5]='o' }
  { Data Now in Array Format   }

END;

-*)


Procedure StrToArray(                S         : STRING;
                                 Var TheArray            );

Var

  P : POINTER;

BEGIN

  P := Ptr( Seg( S ), Succ(Ofs( S )) );
  Move( P^, TheArray, Byte(S[0]) );

END;   { Of StrToArray }

{ƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒ}

(*-

[FUNCTION]

Function  ArrayToStr(            Var TheArray;
                                     Len       : BYTE    ) : STRING;

[PARAMETERS]

TheArray    VAR Address of the source array to convert to a string
Len         Desired final string length

[RETURNS]

Pascal String created from array

[DESCRIPTION]

This function converts an Array of Characters into a PASCAL String.
(NOTE: The input Array need not be terminated in any way, but will
be exactly duplicated up to the length "Len" - even if beyond the
Array!)

[SEE-ALSO]

StrToArray

[EXAMPLE]

TYPE
  TArr = ARRAY[1..10] of CHAR;

VAR
  S   : STRING;
  Arr : TArr;

BEGIN

  Arr[1] := 'Y';
  Arr[2] := 'e';
  Arr[3] := 's';

  S := ArrayToStr( Arr, 3 );

  { S = 'Yes' }

END;

-*)


Function  ArrayToStr(            Var TheArray;
                                     Len       : BYTE    ) : STRING;

Var

  P : POINTER;
  S : STRING;

BEGIN

  P          := Ptr( Seg( TheArray ),Ofs( TheArray ) );
  Move( P^, S[1], Len );
  S[0]       := Char( Len );
  ArrayToStr := S;

END;   { Of ArrayToStr }

{ƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒ}

(*-

[FUNCTION]

Procedure StrToAsciiZ(               S         : STRING;
                                 Var AsciiZStr           );

[PARAMETERS]

S           Pascal String to convert into an AsciiZ String
AsciiZStr   VAR working array ton return AsciiZ string in

[RETURNS]

Function : None
(Var     : [AsciiZStr] The new ASCIIZ String)

[DESCRIPTION]

This Procedure converts a PASCAL String into an ASCIIZ String (a null-
terminated character array).  This is particularly useful when
converting Pascal Strings to C Strings.

[SEE-ALSO]

AsciiZtoStr

[EXAMPLE]

TYPE
  TArr = ARRAY[1..10] of CHAR;

VAR
  S   : STRING;
  Arr : TArr;

BEGIN

  S := 'Yes';
  StrToAsciiZ( S, Arr );

  { Arr[1]='Y' }
  { Arr[2]='e' }
  { Arr[3]='s' }
  { Arr[4]=#0  - NULL Terminated! }

END;

-*)


Procedure StrToAsciiZ(               S         : STRING;
                                 Var AsciiZStr           );

BEGIN

  {------------------------------------------------------------}
  { Convert a string to a array of chars with terminating null }
  {------------------------------------------------------------}

  Move( S[1], AsciiZStr, Byte( S[0] ) );
  TCharArray( AsciiZStr )[ Byte( S[0] ) + 1 ] := #0;

END;

{ƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒ}

(*-

[FUNCTION]

Function  AsciiZtoStr(           Var AsciiZStr           ) : STRING;

[PARAMETERS]

AsciiZStr   VAR address of source AsciiZ string to convert to a string

[RETURNS]

Pascal String created from AsciiZ source string

[DESCRIPTION]

This function converts an ASCIIZ String (a null-terminated character
array) into a PASCAL String.  This is particularly useful when
converting a C String to a Pascal String.

[SEE-ALSO]

StrToAsciiZ

[EXAMPLE]

TYPE
  TArr = ARRAY[1..10] of CHAR;

VAR
  S   : STRING;
  Arr : TArr;

BEGIN

  Arr[1] := 'Y';
  Arr[2] := 'e';
  Arr[3] := 's';
  Arr[4] := #0;

  S := AsciiZtoStr( Arr );

  { S = 'Yes' }

END;

-*)


Function  AsciiZtoStr(           Var AsciiZStr        ) : STRING;


Var

  S : STRING;
  Z : INTEGER;


BEGIN

(*
  ASM

    LDS SI  AsciiZStr
    MOV DI, SI

    CLD
    MOV  AL, 0

    REPZ SCASB

    SUB DI, SI

    MOV Z, DI


  END;
*)

  Z := 0;
  While ( TCharArrayZ(AsciiZStr)[Z] <> #0 ) Do
    Inc( Z );

  Move( AsciiZStr, S[1], Z );
  Byte( S[0] ) := Z;

  AsciiZtoStr  := S;

END;



{ƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒ}




(*-

[FUNCTION]

Function  GetStrNumType(             S         : STRING  ) : BYTE;

[PARAMETERS]

S           "Valued" string needing a type

[RETURNS]

Byte value of typed string.

[DESCRIPTION]

Figures what system is needed to express the valued string.  Some common
systems are:

  String      Type     Value
  ----------- -------- -----
    ####      decimal    1
    ####d     decimal    1
   $####      hex        2
    ####h     hex        2
  0x####      hex        2
    ####b     binary     3

[SEE-ALSO]

[EXAMPLE]

  A := GetStrNumType( '$1234' );

  { A now equals 2 }

-*)

Function  GetStrNumType(             S         : STRING  ) : BYTE;

BEGIN

  S := UpperString( TrimChar( S, ONCENTER, ' ' ) );

  If (   S[1] = '$' ) OR
     ( ( S[1] = '0' ) AND ( UpCase(S[2]) = 'X' ) ) OR
     (   UpCase(S[Byte(S[0])]) = 'H' ) Then
    GetStrNumType := 2
  Else
  If ( UpCase(S[Byte(S[0])]) = 'B' ) Then
    GetStrNumType := 3
  Else
    GetStrNumType := 1;

END;

{ƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒ}

Function  StrToByteEx(               S         : STRING  ) : BYTE;

BEGIN

  Case GetStrNumType( S ) of

    1: StrToByteEx := StrToInt( S );
    2: StrToByteEx := HexToByte( S );
    3: StrToByteEx := BinToByte( S );

  END;

END;

{ƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒ}

(*-

[FUNCTION]

[PARAMETERS]

[RETURNS]

[DESCRIPTION]

[SEE-ALSO]

[EXAMPLE]

-*)

Function  StrToWordEx(               S         : STRING  ) : WORD;

BEGIN

  Case GetStrNumType( S ) of

    1: StrToWordEx := StrToInt( S );
    2: StrToWordEx := HexToWord( S );
    3: StrToWordEx := BinToWord( S );

  END;

END;

{ƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒ}

(*-

[FUNCTION]

Function  StrToIntEx(                S         : STRING  ) : INTEGER;

[PARAMETERS]

S           Source String representing Integer Value

[RETURNS]

Integer Value

[DESCRIPTION]

****** THIS FUNCTION NOT IMPLEMENTED! ******

[SEE-ALSO]

[EXAMPLE]

-*)

Function  StrToIntEx(                S         : STRING  ) : INTEGER;

BEGIN

  Case GetStrNumType( S ) of

    1: StrToIntEx := StrToInt( S );
    2: StrToIntEx := HexToInt( S );
    3: StrToIntEx := BinToInt( S );

  END;

END;


{ƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒ}

(*-

[FUNCTION]

[PARAMETERS]

[RETURNS]

[DESCRIPTION]

[SEE-ALSO]

[EXAMPLE]

-*)

Function  StrToLongEx(               S         : STRING  ) : LONGINT;

BEGIN

  Case GetStrNumType( S ) of

    1: StrToLongEx := StrToInt( S );
    2: StrToLongEx := HexToLong( S );
    3: StrToLongEx := BinToLong( S );

  END;

END;


{ƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒ}

(*-

[FUNCTION]

Function  VStrNew(                S             : STRING        ) : POINTER;


[PARAMETERS]
StringLen   Maximum string length to allocate
DefString   Default new string text

[RETURNS]

Pointer to New String and data.

[DESCRIPTIO]

This function allocates room for the specified string on the heap,
copies the string to the heap, and returns a point to the new copy.

There are advantages in obtaining strings from Heap Memory as opposed
to the Stack, not the least of which is the fact that the Heap is larger
and more Dynamic where the Stack has to be set at Compile Time.

[SEE-ALSO]

VStrGet
VStrDispose

[EXAMPLE]

VAR
  P : POINTER;

BEGIN

  P := VStrNew( 'This is the String' );

  { P now points to the String Data as well as the Memory Allocations }

END;

-*)

Function  VStrNew(                S             : STRING        ) : POINTER;


Var

  TempPtr  : PByteArray;
  AllocLen : WORD;

BEGIN

  AllocLen := Byte(S[0])+1;

  If MaxAvail<AllocLen Then
    VStrNew := NIL
  ELSE
  BEGIN
    GetMem( TempPtr, AllocLen );
    Move( S, TempPtr^, AllocLen );
    VStrNew := TempPtr;
  END;

END;

{ƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒ}

(*-

[FUNCTION]

Function  VStrGet(                StringPtr     : PString       ) : STRING;


[PARAMETERS]

StringPtr   String Pointer

[RETURNS]

Pascal String in Heap Memory

[DESCRIPTION]

This is the

There are advantages in obtaining strings from Heap Memory as opposed
to the Stack, not the least of which is the fact that the Heap is larger
and more Dynamic where the Stack has to be set at Compile Time.

[SEE-ALSO]

VStrNew
VStrDispose

[EXAMPLE]

VAR
  S : STRING;

BEGIN

  S := VStrGet( VStrNew( 'This is the String' ) );

  {--------------------------------------------------------------------}
  { S now contains "This is the String" from the Dynamically allocated }
  { from the Heap while the String Pointer itself also includes the    }
  { Memory Allocation associated with this String Pointer              }
  {--------------------------------------------------------------------}

END;

-*)

Function  VStrGet(                StringPtr     : PString       ) : STRING;


BEGIN

  If StringPtr=NIL Then
    VStrGet := ''
  Else
    VStrGet := StringPtr^;

END;


{ƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒ}

(*-

[FUNCTION]

Procedure VStrDispose(             PrevVStrNew : POINTER );

[PARAMETERS]

PrevVStrNew   Existing String pointer created by VStrNew

[RETURNS]

(None)

[DESCRIPTION]

This is the complementary function to VStrNew.  It will take the
VStrNew string pointer and deallocate it from the heap.  It should
be noted that all the information about the allocated memory size is
already contained with the string pointer data, thus deallocation is
completely invisible to the user.

[SEE-ALSO]

VStrNew
VStrGet

[EXAMPLE]

VAR
  P : POINTER;

BEGIN

  P := VStrNew( 'This is the String' );
  { P now points to the String Data as well as the Memory Allocations }

  VStrDispose( P );

  {-----------------------------------}
  { P now is an unassigned pointer,   }
  { all memory associated with it has }
  { been deallocated                  }
  {-----------------------------------}

END;

-*)

Procedure VStrDispose(            PrevNewString : PString       );

BEGIN

  If PrevNewString<>NIL Then
    FreeMem( PrevNewString, Byte(PrevNewString^[0])+1 );

END;

{ƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒ}

(*-

[FUNCTION]

[PARAMETERS]

[RETURNS]

[DESCRIPTION]

[SEE-ALSO]

[EXAMPLE]

-*)

Function  VStrListNew(            Flags          : WORD;
                                  NumItems       : INTEGER;
                                  ItemLen        : WORD         ) : PStrList;


Type

  MyPByte = ^BYTE;

Var

  NSL      : PStrList;
  Z        : INTEGER;

  LLNs     : PLLStringNode;
  LLNpchar : PLLPcharNode;

BEGIN


  New( NSL );

  Case Flags of

    cslStrings:
    BEGIN

      {------------------------------------}
      { get the memory for all the strings }
      {------------------------------------}

      GetMem( NSL^.SL, NumItems*(ItemLen+1) );

      {----------------------}
      { zero out each string }
      {----------------------}

      For Z:=1 to NumItems Do
        MyPByte( PtrAdd( NSL^.SL, (Z-1)*(ItemLen+1) ) )^:=0;

    END;

    cslPStrings:
    BEGIN

      {------------------------------------------}
      { Get the memory for the array of pointers }
      {------------------------------------------}

      GetMem( NSL^.SL, SizeOf( POINTER ) * NumItems );

      {-------------------------------------}
      { Now get the memory for each pointer }
      {-------------------------------------}

      For Z := 1 to NumItems Do
      BEGIN
        GetMem( PPStrings( NSL^.SL )^[Z], ItemLen+1 );

        PPStrings( NSL^.SL )^[Z]^ := '';
      END;

    END;


    cslLLStrings:
    BEGIN

      New( LLNs );

      NSL^.SL := LLNs;

      For Z := 2 to NumItems Do
      BEGIN

        New( LLNs^.Next );

        LLNs^.Next^.S := '';

        LLNs := LLNs^.Next;

      END;

      LLNs^.Next := NIL;

    END;


  {$IFNDEF NOSTRINGS}

    cslPChars:
    BEGIN

      {------------------------------------------}
      { Get the memory for the array of pointers }
      {------------------------------------------}

      GetMem( NSL^.SL, SizeOf( POINTER ) * NumItems );

      {-------------------------------------}
      { Now get the memory for each pointer }
      {-------------------------------------}

      For Z := 1 to NumItems Do
      BEGIN

        GetMem( PPointers( NSL^.SL )^[Z], ItemLen+1 );

        StrPCopy( PPChars( NSL^.SL )^[Z], '' );

{        PPChars( NSL^.SL )^[Z] := '';  }

      END;

    END;

    cslLLPChars:
    BEGIN

      New( LLNpchar );

      GetMem( LLNpchar^.S, ItemLen+1 );

      StrPCopy( LLNpchar^.S, '' );

      NSL^.SL := LLNpchar;

      For Z := 2 to NumItems Do
      BEGIN

        New( LLNpchar^.Next );

        GetMem( LLNpchar^.Next^.S, ItemLen+1 );

        StrPCopy( LLNpchar^.Next^.S, '' );

        LLNpchar := LLNpchar^.Next;

      END;

      LLNpchar^.NEXT := NIL;

    END;

  {$ENDIF}

  END; { case statement }

  {-----------------------------------------}
  { Fill in the rest of the New String List }
  {-----------------------------------------}

  NSL^.Flags   := Flags;
  NSL^.Items   := NumItems;
  NSL^.ItemLen := ItemLen;

  VStrListNew  := NSL;


END; { function VStrListNew }


{ƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒ}

Procedure VStrListDispose(        SL             : PStrList     ) ;

Var

  Z            : INTEGER;
  LLNs         : PLLStringNode;
  nextLLNs     : PLLStringNode;
  LLNpchar     : PLLPCharNode;
  nextLLNPchar : PLLPCharNode;


BEGIN

  Case SL^.Flags of

    cslStrings:
    BEGIN

      FreeMem( SL^.SL, SL^.Items*(SL^.ItemLen+1) );

    END;

    cslPStrings:
    BEGIN

      {---------------------------------------}
      { First free the memory for each string }
      {---------------------------------------}

      For Z := 1 to SL^.Items Do
        FreeMem( PPStrings( SL^.SL )^[Z], SL^.ItemLen+1 );

      {-------------------------------------------}
      { Free the memory for the array of pointers }
      {-------------------------------------------}

      FreeMem( SL^.SL, SizeOf( POINTER ) * SL^.Items );

    END;


    cslLLStrings:
    BEGIN

      LLNs := SL^.SL;

      For Z := 1 to SL^.Items Do
      BEGIN

        nextLLNs := LLNs^.Next;

        Dispose( LLNs );

        LLNs := nextLLNs;

      END;

    END;


    cslPChars:
    BEGIN


      {---------------------------------------}
      { First free the memory for each string }
      {---------------------------------------}

      For Z := 1 to SL^.Items Do
        FreeMem( PPChars( SL^.SL )^[Z], SL^.ItemLen+1 );

      {-------------------------------------------}
      { Free the memory for the array of pointers }
      {-------------------------------------------}

      Freemem( SL^.SL, SizeOf( POINTER ) * SL^.Items );

    END;

    cslLLPChars:
    BEGIN

      LLNpchar := SL^.SL;

      For Z := 1 to SL^.Items Do
      BEGIN

        nextLLNpchar := LLNpchar^.Next;

        FreeMem( LLNpchar^.s, SL^.ItemLen+1 );

        Dispose( LLNpchar );

        LLNpchar := nextLLNpchar;

      END;


    END;

  END; { case statement }

  Dispose( SL );

END;

{ƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒ}

Function  VStrListGetPtr(         StrList        : PStrList;
                                  StrNum         : INTEGER      ) : PSTRING;


Var

  Z        : INTEGER;
  LLNs     : PLLStringNode;
  LLNpchar : PLLPCharNode;


BEGIN

  Case StrList^.Flags of

    cslStrings:
    BEGIN

      VStrListGetPtr := PtrAdd( StrList^.SL,
                                (StrNum-1)*(StrList^.ItemLen+1) );

    END;

    cslPStrings:
    BEGIN

      VStrListGetPtr := PPStrings( StrList^.SL )^[StrNum];

    END;


    cslLLStrings:
    BEGIN

      Z    := 1;

      LLNs := StrList^.SL;

      While (Z<>StrNum) and (LLNS^.Next<>NIL) Do
      BEGIN
        Inc( Z );
        LLNs := LLNs^.Next;
      END;

      If Z=StrNum Then
        VStrListGetPtr := @LLNs^.S
      ELSE
        VStrListGetPtr := NIL;

    END;


    cslPChars:
    BEGIN

      VStrListGetPtr := pointer( PPChars( StrList^.SL )^[StrNum] );

    END;

    cslLLPChars:
    BEGIN

      Z    := 1;

      LLNpchar := StrList^.SL;

      While (Z<>StrNum) and (LLNpchar^.Next<>NIL) Do
      BEGIN
        Inc( Z );
        LLNpchar := LLNpchar^.Next;
      END;


      If Z=StrNum Then
        VStrListGetPtr := pointer( LLNpchar^.S )
      ELSE
        VStrListGetPtr := NIL;

    END;

  END; { case statement }


END;


{ƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒ}

Function  VStrListGetStr(         StrList        : PStrList;
                                  StrNum         : INTEGER      ) : STRING;

Var

  Z        : INTEGER;
  LLNs     : PLLStringNode;
  LLNpchar : PLLPCharNode;

BEGIN


  Case StrList^.Flags of

    cslStrings:
    BEGIN

      VStrListGetStr := PString( PtrAdd( StrList^.SL,
                                         (StrNum-1)*
                                            (StrList^.ItemLen+1) ) )^;

    END;

    cslPStrings:
    BEGIN

      VStrListGetStr := PString( PPStrings( StrList^.SL )^[StrNum] )^;

    END;


    cslLLStrings:
    BEGIN

      Z    := 1;

      LLNs := StrList^.SL;

      While (Z<>StrNum) and (LLNS^.Next<>NIL) Do
      BEGIN
        Inc( Z );
        LLNs := LLNs^.Next;
      END;

      If Z=StrNum Then
        VStrListGetStr := LLNs^.S
      ELSE
        VStrListGetStr := '';

    END;

  {$IFNDEF NOSTRINGS}

    cslPChars:
    BEGIN

      VStrListGetStr := StrPas( PPChars( StrList^.SL )^[StrNum] );

    END;

    cslLLPChars:
    BEGIN

      Z    := 1;

      LLNpchar := StrList^.SL;

      While (Z<>StrNum) and (LLNpchar^.Next<>NIL) Do
      BEGIN
        Inc( Z );
        LLNpchar := LLNpchar^.Next;
      END;


      If Z=StrNum Then
        VStrListGetStr := StrPas( LLNpchar^.S )
      ELSE
        VStrListGetStr := '';



    END;

  {$ENDIF}

  END; { case statement }


END;


{ƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒ}

Procedure VStrListPutStr(         StrList        : PStrList;
                                  StrNum         : INTEGER;
                                  StrToPut       : STRING       );


Var

  Z        : INTEGER;
  LLNs     : PLLStringNode;
  LLNpchar : PLLPCharNode;

BEGIN

  Case StrList^.Flags of

    cslStrings:
    BEGIN

      PString( PtrAdd( StrList^.SL,
                       (StrNum-1)*
                         (StrList^.ItemLen+1) ) )^ := StrToPut;

    END;

    cslPStrings:
    BEGIN

      PString( PPStrings( StrList^.SL )^[StrNum] )^ := StrToPut;

    END;


    cslLLStrings:
    BEGIN

      Z    := 1;

      LLNs := StrList^.SL;

      While (Z<>StrNum) and (LLNS^.Next<>NIL) Do
      BEGIN
        Inc( Z );
        LLNs := LLNs^.Next;
      END;

      If Z=StrNum Then
        LLNs^.S := StrToPut;

    END;


  {$IFNDEF NOSTRINGS}

    cslPChars:
    BEGIN

      StrPCopy( PPChars( StrList^.SL )^[StrNum], StrToPut );

    END;

    cslLLPChars:
    BEGIN

      Z    := 1;

      LLNpchar := StrList^.SL;

      While (Z<>StrNum) and (LLNpchar^.Next<>NIL) Do
      BEGIN
        Inc( Z );
        LLNpchar := LLNpchar^.Next;
      END;

      If Z=StrNum Then
        StrPCopy(  LLNpchar^.S, StrToPut );


    END;

  {$ENDIF}

  END; { case statement }



END;


{ƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒ}

Function  VStrListGetPChar(       StrList        : PStrList;
                                  StrNum         : INTEGER      ) : PChar;

Var

  Z        : INTEGER;
  LLNpchar : PLLPCharNode;


BEGIN


  Case StrList^.Flags of

    cslStrings:
    BEGIN

    END;

    cslPStrings:
    BEGIN

    END;


    cslLLStrings:
    BEGIN

    END;


    cslPChars:
    BEGIN

      VStrListGetPChar := PPChars( StrList^.SL )^[StrNum];

    END;

    cslLLPChars:
    BEGIN

      Z    := 1;

      LLNpchar := StrList^.SL;

      While (Z<>StrNum) and (LLNpchar^.Next<>NIL) Do
      BEGIN
        Inc( Z );
        LLNpchar := LLNpchar^.Next;
      END;


      If Z=StrNum Then
        VStrListgetPchar := LLNPchar^.s
      ELSE
        VStrListGetPchar := NIL;

    END;


  END; { case statement }

END;


{ƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒ}

Procedure VStrListPutPChar(       StrList        : PStrList;
                                  StrNum         : INTEGER;
                                  PCharToPut     : PChar        );


Var

  Z        : INTEGER;
  LLNs     : PLLStringNode;
  LLNpchar : PLLPCharNode;

BEGIN

{$IFNDEF NOSTRINGS}

  Case StrList^.Flags of

    cslStrings:
    BEGIN

      PString( PtrAdd( StrList^.SL,
                       (StrNum-1)*
                         (StrList^.ItemLen+1) ) )^ := StrPas( PCharToPut );

    END;

    cslPStrings:
    BEGIN

      PString( PPStrings( StrList^.SL )^[StrNum] )^ := StrPas( PCharToPut );

    END;


    cslLLStrings:
    BEGIN

      Z    := 1;

      LLNs := StrList^.SL;

      While (Z<>StrNum) and (LLNS^.Next<>NIL) Do
      BEGIN
        Inc( Z );
        LLNs := LLNs^.Next;
      END;

      If Z=StrNum Then
        LLNs^.S := StrPas( PCharToPut );

    END;


    cslPChars:
    BEGIN

      StrCopy( PPChars( StrList^.SL )^[StrNum], PCharToPut );

    END;

    cslLLPChars:
    BEGIN

      Z    := 1;

      LLNpchar := StrList^.SL;

      While (Z<>StrNum) and (LLNpchar^.Next<>NIL) Do
      BEGIN
        Inc( Z );
        LLNpchar := LLNpchar^.Next;
      END;

      If Z=StrNum Then
        StrCopy( LLNpchar^.S, PCharToPut );


    END;


  END; { case statement }


{$ENDIF}

END;


(*-

[FUNCTION]

Function ColorFromString(         S              : STRING       ) : BYTE;

[PARAMETERS]

S           Text color, as a string.  IE: "RED"

[RETURNS]

Numeric Color Value

[DESCRIPTION]

This function converts a Text String Color Name into a Color Value.
This function is NOT Case Sensitive.

[SEE-ALSO]

[EXAMPLE]

CONST
  ColorNames = ARRAY[0..7] of STRING =
               ( 'BLACK','WHITE','BLUE','GREEN',
                 'RED','YELLOW','CYAN','MAGENTA' );
VAR
  I : INTEGER;

BEGIN

  Textbackground( WHITE );

  For i := 0 to 7 Do
  BEGIN
    TextColor( WColorFromString( ColorNames[i] ) );
    WriteLn( ColorNames[i] );
  END;  { For i }

END;

-*)

Function ColorFromString(        S              : STRING       ) : BYTE;

Var

  Z     : INTEGER;
  Found : BOOLEAN;

Const

  Colors : Array[0..15] of STRING[15] = ( 'BLACK',
                                          'BLUE',
                                          'GREEN',
                                          'CYAN',
                                          'RED',
                                          'MAGENTA',
                                          'BROWN',
                                          'LIGHTGRAY',
                                          'DARKGRAY',
                                          'LIGHTBLUE',
                                          'LIGHTGREEN',
                                          'LIGHTCYAN',
                                          'LIGHTRED',
                                          'LIGHTMAGENTA',
                                          'YELLOW',
                                          'WHITE'          );

BEGIN

  S := UpperString(S);
  Z := 0;

  REPEAT

    Found := Pos(Colors[Z], S) <> 0;

    If NOT Found Then
      Inc(Z);

  UNTIL Found OR (Z > 15);

  If Found Then
    ColorFromString := Z
  Else
    ColorFromString := 7;

END; { Of ColorFromString }



{ƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒ}
{ƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒ}
{ƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒ}


BEGIN


END.